00100	C ***** SCANNER *************************  
00200	C* SCANR,BGSORT,FMT,RANR,SQYY,COLTTY,READER,CLEAN,ACCEL,POINTR  7/74
00300		SUBROUTINE SCANR
00400		DIMENSION IP(30)
00500		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
00600		1 ,IQ(27),ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
00700		1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
00800		EQUIVALENCE(IF,ISCA(6)),(ISS,ISCA(9)),(IE,ISCA(5)),(IDOT,IDAT(11))
00900		1 ,(IEN,ISCA(4)),(IP,PL)
01000	C 2/74 IP IS NOW EQUIV TO PL!  USED TO BE IP WITH P.(HURT 'TAP' ROUTINE.)
01100	C  WILL THIS DO ANYTHING TO MUSIC5 VERSION??
01200	      NNUM=-1     
01300	      ISKP=0
01400	      JJ=0  
01500		XMINUS=1.    
01600	999      IDECI=-1  
01700	      M=0   
01800	2799	N=INP(ML)
01900		IF(N.NE.IQT)GO TO 899
02000		JA=-1
02100		ML=ML+1
02200		ISUB=8
02300		JJ=JJ+1
02400		VX(JJ)=ML
02500	C  POINTS TO FIRST LIT. CHAR.
02600		DO 1177 K=ML,144
02700		IF(INP(K).NE.IQT)GO TO 1177
02800		ML=K+1
02900	2177	N=INP(ML)
03000		GO TO 899
03100	1177	CONTINUE
03200	C  SKIPS 'LIT' ITEMS IN RAN. SELECTION
03300	899   ML=ML+1
03400		IF(N.EQ.ISEMI)GO TO 751
03500		IF(N.NE.IBLA)GO TO 510
03600	4702      IF(ISKP)202,2799,2799
03700	
03800	510	IF(JA)GO TO 70
03900	C********** MAY 22,71
04000	      DO 77 K=1,12   
04100	      IF(N.NE.ISCA(K))GO TO 77
04200		IF(K.EQ.2)GO TO 1511
04300		IF(K.NE.4)GO TO 511
04400	1511	NSWCH=K-4
04500		GO TO 2177
04600	C  TO SWITCH ALWAYS USE OCT.#  /PBF4/  /OE5/  P=PROXIMITY, O=ORDINARY
04700	C ************ MAY 22,71
04800	511   NNUM=K
04900		JJ=JJ+1
05000		NFLG=-1
05100		N=INP(ML)
05200		IF(N.NE.IF)GO TO 410
05300		NNUM=NNUM-1
05400		GO TO 610
05500	410	IF(N.NE.ISS)GO TO 3410
05600		NNUM=NNUM+1
05700	610	ML=ML+1
05800		N=INP(ML)
05900	3410	IF(N.EQ.IEN)GO TO 3411
06000		IF(N.NE.'I')GO TO 371
06100	C  'END' OR 'FINE' WILL END INST.
06200	C******** MAY 20,71
06300	3411	VX(JJ)=10000.
06400		IF(DUR(LK))DUR(LK)=1000.
06500		IAMP=-1
06600		RETURN
06700	371	IF(N.EQ.ISEMI)GO TO 5410
06800		IF(N.EQ.IBLA)GO TO 5410
06900		DO 177 KN=2,9
07000		IF(N.NE.IDAT(KN))GO TO 177
07050		IF(KN.EQ.9)CALL ERR(4)
07075	C FOUND OCTAVE NUM.8 -- TOO HIGH!
07100		JSCA=KN-2
07200		ML=ML+1
07300		GO TO 2410
07400	177	CONTINUE
07500		GO TO 6410
07600	5410	KN=-1
07700	6410	IF(NSWCH.EQ.0)GO TO 2410
07800		IF(KN)GO TO 7410
07900	CC	IF(N.EQ.'+')NOLD=NOLD+6
08000	CC	IF(N.EQ.'-')NOLD=NOLD-6
08100	C /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
08200	7410	IF(NOLD-NNUM.LE.5)GO TO 7411
08300		IF(JSCA.LT.7)JSCA=JSCA+1
08400	7411	IF(NOLD-NNUM.GE.-5)GO TO 2410
08500		IF(JSCA.GT.0)JSCA=JSCA-1
08600	C   WILL JUMP TO NEAREST NOTE ***********  MAY 22,71
08700	2410	VX(JJ)=JSCA*12+NNUM
08800		NOLD=NNUM
08900	C ********** MAY 22,71
09000	4410	NNUM=-2
09100		IF(INP(ML).EQ.ISEMI)RETURN
09200	C   ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
09300		IF(N.EQ.IXX)GO TO 210
09400		IF(N.EQ.'*')GO TO 210
09500		GO TO 310
09600	C *********MAY 22,71
09700	77    CONTINUE    
09800	70    IF(N.NE.'-')GO TO 71   
09900	      XMINUS=-1.   
10000	      GO TO 2799   
10100	210	JJ=JJ+1
10200		IF(JJ.EQ.1)GO TO 3310
10300	C****** MAY 19,71
10400		XMINUS=1.
10500		VX(JJ)=0
10600	C  'X N1,N2' MAY REPLACE 'REP N1,N2'.  N2=0 BECOMES N2=2
10700		GO TO 310
10800	71	IF(N.EQ.IXX)GO TO 210
10900		IF(N.EQ.'*')GO TO 210
11000		IF(N.EQ.'R')GO TO 73     
11100	
11200	1410  DO 78 K=1,11
11300	      IF(N.NE.IDAT(K))GO TO 78
11400		ISKP=-1
11500		IF(N.NE.IDOT)GO TO 79
11600		IDECI=M
11700		GO TO 75
11800	79    M=M+1 
11900	      IP(M)=K-1   
12000		GO TO 75
12100	78	CONTINUE
12200		IF(N.EQ.IE)GO TO 7811
12300		IF(N.NE.IF)GO TO 781
12400	C  'END' OR 'FINE' WILL END INST.
12500	7811	JJ=1
12600		GO TO 3411
12700	781	IF(N.EQ.'/')N=ISEMI
12800	C   FOR MOTIVIC TRANFORMATIONS
12900	
13000	75	KN=INP(ML)
13100		IF(KN.EQ.IXX)GO TO 202
13200		IF(KN.EQ.'*')GO TO 202
13300	C  FOR 2X3, 2*3, ETC.    CHECK THIS OUT.  6/74
13400	CC75	IF(INP(ML).NE.IXX)GO TO 752
13500	CC	ML=ML-1
13600	CC	GO TO 202
13700	C  FOR 'X' AND '*' WITHOUT SPACES.
13800		IF(N.EQ.ISEMI)GO TO 751
13900		IF(KN.NE.1)GO TO 2799
14000	C WHEN IS INP(ML) (I.E. KN) SET TO 1?????
14100	751	IF(ISKP.EQ.0)RETURN
14200	202   IF(IDECI.NE.-1)GO TO 302    
14300	      IDECI=0     
14400	      GO TO 402   
14500	302   IDECI=M-IDECI     
14600	402   KN=0  
14700	      IEXP=M-1    
14800	      IF(M.LT.1)M=1     
14900	      DO 171 K=1,M
15000		KV=10**IEXP
15100		IF(IEXP.EQ.0)KV=1
15200	      KN=KN+IP(K)*KV 
15300	171     IEXP=IEXP-1     
15400	      A=10**IDECI 
15500		IF(IDECI.EQ.0)A=1.
15600		JJ=JJ+1
15700		VX(JJ)=KN/A*XMINUS
15800		IF(ISUB.EQ.1)RETURN
15900		IF(CODE.NE.-22.)XMINUS=1.
16000	C  ONLY ONE - NEEDED FOR RHY.COMPOSITE
16100	1310	IF(INP(ML).NE.1)GO TO 310
16200		VX(JJ+1)=VX(JJ)*2.
16300		JJ=JJ+1
16400		ML=ML+1
16500		GO TO 1310
16600	206	ML=ML+2
16700	3310	VX(1)=-99.
16800	C******** MAY 19,71
16900	310      ISKP=0
17000	        IF(N.NE.ISEMI)GO TO 999
17100	
17200	    	RETURN
17300	73	JJ=JJ+1
17400		 IF(INP(ML).EQ.IE)GO TO 206    
17500	C   NEXT IS FOR A REST ('R')  
17600	      VX(JJ)=85.
17700	C 7/75	GO TO 4410
17710	731	N=INP(ML)
17720		IF(N.EQ.'/')RETURN
17730		IF(N.EQ.ISEMI)RETURN
17740		IF(N.NE.IBLA)GO TO 899
17750		ML=ML+1
17760		GO TO 731
17800	  	END
17900	
18000		SUBROUTINE BGSORT(BW)
18100	C  THIS SORTS BG TIMES SO NONE ARE DUPLICATED IN BNW ARRAY.
18200	C  ALLOWS 100 BG TIMES.
18300		COMMON /Q/ BNW(100),NWZ
18400		DO 5308 K=1,NWZ
18500		X=BNW(K)-.0001
18600		Y=X+.0002
18700	C   ROUND-OFF NONSENSE
18800		IF(BW.LE.X)GO TO 5308
18900	 	IF(BW.LT.Y)RETURN
18950	5308	CONTINUE
19000		NWZ=NWZ+1
19100		BNW(NWZ)=BW
19200		RETURN
19300		END
19400	
19500		SUBROUTINE FMT(JFM,INP,MLX)
19600		DIMENSION JFM(3),INP(1)
19700		DO 1 MLX=2,72
19800		J=INP(MLX)
19900		IF(J.EQ.' ')GO TO 2
20000		IF(J.EQ.',')GO TO 2
20100		IF(J.EQ.';')GO TO 2
20200	1	IF(J.EQ.':')GO TO 3
20300	C  SPACE=COMMA=SPACE, ALSO STOPS ON ";"
20400	3	CALL ERR(1)
20500	C  ERROR IF COLON IS FOUND OR THERE IS NO END MARK 
20600	2	MLX=MLX+1
20700		IF(MLX.GT.7)MLX=7
20800		JFM(2)='0'+(MLX-2)*536870912
20900	C   FINDS NUMBER FOR 'A' FORMAT
21000		END
21100	
21200	      SUBROUTINE RANR(VX,K)
21300	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
21400	      DIMENSION VX(1)
21500	      X=VX(K)
21600	      Y=VX(K+1)
21700	      IF(X.GT.Y)VX(K)=X+.999
21800	      IF(Y.GE.X)VX(K+1)=Y+.999
21900	      RETURN
22000	      END
22100	
22200	      SUBROUTINE SQYY(YY,X,Y,Z)
22300	      YY=2.*Z/(X+Y)
22400	      IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
22500	      RETURN
22600	      END
22700	
22800		SUBROUTINE COLTTY(JNP,JT)
22900		COMMON /TYP/SOS,JOUT,LN,ITYP,TPALN(4),JED /FRMT/J(2)
23000		DIMENSION JNP(1)
23100		DATA J(2)/'72A1)'/
23200		DO 1 K=72,1,-1
23300	1	IF(JNP(K).NE.' ')GO TO 2
23400		K=1
23500	2	IF(JT.EQ.21)GO TO 3
23600		J(1)='  (1X'
23700		IF(LN.EQ.0)GO TO 5
23800		J(1)='(I5,X'
23900		WRITE(JT,J)LN,(JNP(L),L=1,K)
24000		RETURN
24100	3	J(1)='    ('
24200	5	WRITE(JT,J)(JNP(L),L=1,K)
24300		END
24400	
24500		FUNCTION READER(JNP)
24600		DIMENSION JNP(72)
24700		COMMON /TYP/SOS,JOUT,LN,ITYP,TPALN(4),JED
24800		1 /FRMT/J(2)
24900		DATA TPALN/20H(' TYPE A LINE'/)   /
25000		J(1)='    ('
25100		READER=0
25200		IF(ITYP)GO TO 1
25300	6 	TYPE TPALN
25400		ACCEPT J,JNP
25500		IF(JED)CALL COLTTY(JNP,21)
25600		IF(JNP(1).EQ.' ')GO TO 6
25700		RETURN
25800	1	IF(LN.NE.0)GO TO 5
25900		READ(1,J,END=3)JNP
26000		GO TO 7
26100	5	J(1)='  (I,'
26200		READ(1,J,END=3)LN,JNP
26300	7	IF(SOS)CALL COLTTY(JNP,JOUT)
26400		RETURN
26500	3	READER=-1
26600		END
26700	
26800		SUBROUTINE QUAD
26900	C  DUMMY -- FOR NOW.  7/74
27000		END
27100	
27200		FUNCTION RMOVX(W,Y,Z)
27300		IF(W.EQ.0)W=.01
27400		IF(Y.EQ.0)Y=.01
27500		RMOVX=Y*((W/Y)**Z)
27600		END
27700	
27800		SUBROUTINE CLEAN(INP,LEND)
27900		DIMENSION INP(1)
28000	C  CLEAR THE END OF ARRAY
28100		M=72
28200		LEND=-1
28300		K=0
28400	1	K=K+1
28500		NN=INP(K)
28600		IF(NN.EQ.';')GO TO 2
28700		IF(NN.EQ.'/')GO TO 2
28800		IF(NN.EQ.'<')GO TO 3
28900	C  USE < FOR COMMENT--  AS IN MUS10
29000		IF(NN.EQ.',')INP(K)=' '
29100	C  CHANGE ALL COMMAS TO BLANKS
29200		IF(NN.EQ.':')CALL ERR(1)
29300		IF(NN.NE.'"')GO TO 4
29400	7	K=K+1
29500		IF(INP(K).EQ.'"')GO TO 4
29600		IF(K.LT.M)GO TO 7
29700		CALL ERR(5)
29800	2	LEND=K
29900	4	IF(K.LT.M)GO TO 1
30000	3	IF(LEND.GT.0)RETURN
30100		IF(M.EQ.144)CALL ERR(2)
30200		CALL READER(INP(73))
30300	C  GO READ ANOTHER LINE.
30400		M=144
30500		K=72
30600		GO TO 1
30700		END
30800	
30900		SUBROUTINE ERR(K)
31000		GO TO(1,2,3,4,5)K
31010		TYPE 199,K
31082	199	FORMAT(' ERROR!!  LAST LINE READ =',I6)
31100		CALL EXIT
31200	1	TYPE 11
31300		CALL EXIT
31400	11	FORMAT(' ILLEGAL COLON')
31500	2	TYPE 12 
31600		CALL EXIT
31610	12	FORMAT(' NO END MARK')
31700	3	TYPE 13
31705		CALL EXIT
31710	13	FORMAT(' MORE THAN 2 PARENS OPEN')
31800	4	TYPE 14
31810		CALL EXIT
31820	14	FORMAT(' SOME NUMBER TOO BIG')
31900	5	TYPE 15
32000		CALL EXIT
32200	15	FORMAT(' OPEN QUOTES')
32300		END
32400	
32500		SUBROUTINE ACCEL
32600		COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
32700		1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
32800		1 ,P1(27),JFM(4),COPY(30),IFM(80)
32900		1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
33000		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
33100		1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
33200		1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
33300		COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
33400		1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
33500		1 ZZ,CHN,YY 
33600		1 /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
33700		1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
33800		1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
33900	C  /C/=26
34000	      IF(T5.EQ.1)GO TO 4020
34100		XA=RA
34200	7020  RA=V(IA+K)
34300	      IF(RA.EQ.10000.)RETURN
34400	4020  RD=1  
34500	      IF(RA.LT.0)RD=-1. 
34600	      RA=RA*RD    
34700	      IF(KA.EQ.0)RA=RA-RC     
34800	      W=RA  
34900	      RB=W  
35000	      IF(W.LE.Z)GO TO 2020    
35100	      IF(Z.NE.0)GO TO 3020    
35200	      RA=RA/Y     
35300	      RB=-1.
35400	      RC=0  
35500	      GO TO 8020  
35600	3020      W=Z     
35700	      RC=W+RC     
35800	      GO TO 24    
35900	2020      RC=0    
36000	24	IF(X.NE.Y)GO TO 424
36100		RA=W/X
36200		GO TO 8020
36300	C   DUR OF TMP + BG TIME OF TMP - NOTE VALUE - 
36400	C   BG TIME OF NOTE. CHN=TBG.
36500	424	RAX=XT(J)
36600		RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
36700		XT(J)=RAX+YY*RA
36800	8020      IF(KA.EQ.0)RA=RA+XA 
36900	      KA=1  
37000	      IF(RC.NE.0)GO TO 1011   
37100	      IF(T5.EQ.1)RETURN
37200	C  T5=1 IN 'RUNIT'
37300	      V(IA+K)=RA*RD     
37400	      IF(K.EQ.IZ)RETURN     
37500	C*********** JUNE 1,71
37600	1011      IF(T5.EQ.1)GO TO 2011     
37700	      K=K+1 
37800	      IF(ZZ.NE.0)Z=Z-W  
37900	      IF(Z.GT.0)GO TO 7020
38000		IF(RB.EQ.-1.)GO TO 7020     
38100	      IC=IC+1     
38200	      IF(RB.EQ.W)RETURN
38300	      KA=0  
38400	      K=K-1 
38500	      RETURN
38600	2011      XA=RA   
38700		IF(K.GT.1)GO TO 9020
38800		K=I-6
38900	      ZPAR=-9900.-CHN-ZZ
39000	      DO 3011 KL=8,I     
39100	      IF(V(K).NE.ZPAR)GO TO 3011
39200		IF(V(K+1).EQ.990000.)GO TO 9020    
39300	3011      K=K-1
39400	9020      W=ZZ  
39500		IF(V(K+3))K=K+3
39600	C   ABOVE IS FOR TYPED IN TEMPO CHANGES
39700		KA=K+3
39800	      ZZ=V(KA)
39900	C   DUR OF NEXT TEMPI
40000		X=V(KA+1)
40100		Y=V(KA+2)
40200	213      KA=0  
40300	      Z=ZZ  
40400		CALL SQYY(YY,X,Y,Z)
40500	      CHN=CHN+W   
40600		XT(J)=X
40700	      IF(KA.EQ.1)Z=0    
40800	      RA=PR 
40900		KA=0
41000		K=K+3
41100		GO TO 4020
41200		END
41300	
41400		SUBROUTINE POINTR(INUM,IPAR,ISTRT,KODE)
41500		COMMON/A/ V(2000)
41600	C  TO FIND POINTERS TO LISTS, ETC. IN V ARRAY WHEN USING SUBR.
41700	C KODES:  -22=RHY  -33=NOTES  -44=NUMS  -46=RLIST  -36=RNOTES
41800	C   -11=SUBN  -12=SUBR  -55=MOVE NUMS  -56=MOVE NOTES
41900	C  -66=DUPL   -88=LIT  -57=MOVE RANGE NUMS  -58=MOVE RNG NOTES
42000		DO 1 K=1,2000
42100		N=V(K)
42200		IF(N.LT.10000)GO TO 1
42300		IF(N/10000.NE.INUM)GO TO 1
42400		IF(MOD(N,10000).NE.IPAR)GO TO 1
42500		ISTRT=K+4
42600		KODE=V(K+2)
42700		ICNT=V(K+3)
42800		IF(IABS(KODE).LT.11)ISTRT=ISTRT-1
42900		RETURN
43000	C  FINDS FIRST OCCURRENCE OF PARAM AND INST ONLY.
43100	1	CONTINUE
43200		END